home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb8.arc / LU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-02-23  |  16.8 KB  |  513 lines
  1. program LibraryUtility;
  2.  
  3. {
  4.                 written 10/09/84 by Steve Freeman
  5.  
  6.   This program was written to function as Gary Novosielski's LU.  As such it
  7.   will function as a utility to manipulate library members under any operating
  8.   system which will support TURBO Pascal.  Minor rewrites may be necessary for
  9.   other versions of Pascal.
  10.  
  11.   This program is placed into the Public Domain by the author and, as a Public
  12.   Domain program, may NOT be used for commercial purposes.
  13.  
  14.  
  15.   Notes by John Plocher
  16.  
  17.   The program only uses a subset of the info stored in the library:
  18.  
  19.           --- Makeup of a library entry header ---
  20.       status           :  (Unused, in use, and deleted)
  21.       name             :  (Name of member stored in library)
  22.       ext              :  (Type "    "      "    "    "    )
  23.       index            :  (where in lib this member is stored)
  24.       length_of_member :  (it's length )
  25.       CRC              :  *** NOT IMPLEMENTED ***
  26.       CreationDate     :  *** NOT IMPLEMENTED ***
  27.       LastChangeDate   :  *** NOT IMPLEMENTED ***
  28.       CreationTime     :  *** NOT IMPLEMENTED ***
  29.       LastChangeTime   :  *** NOT IMPLEMENTED ***
  30.       PadCount         : (used internally by LU)
  31.       filler           : ( room for expansion )
  32.  
  33.  
  34.  
  35.         Modification history
  36.  
  37.        Version    Date       Who            Comments
  38.        -------    ----       ---            --------
  39.        1.22        1/12/85   John Plocher   Made library selection part of
  40.                                             the program loop - No need to
  41.                                             re-run LU to work on other
  42.                                             libraries.  Changed active/total
  43.                                             entries used display to reflect
  44.                                             the fact that the library itself
  45.                                             always uses the first entry and
  46.                                             thus shouldn't be counted.
  47.        1.21        1/12/85   John Plocher   Fixed MakeName bug where a
  48.                                             filetype < 3 chars was incorrectly
  49.                                             handled.  See MakeName comments.
  50.        1.20        1/12/85   John Plocher   Added windows and function keys
  51.        1.10        1/11/85   John Plocher   Rewrote to use screen in an
  52.                                             intelegent manner with all
  53.                                             data visable at one time.
  54.                                             Also reformatted source code in
  55.                                             a readable format.
  56.        1.00       10/ 9/84   Steve Freeman  Initial coding
  57. }
  58.  
  59. const V {ersion}       = '1.23';
  60.       BufferSize       =  127;      { maximum size of data buffer - 1 }
  61.       EntriesPerBuffer =  4;        { (BufferSize+1)/32 }
  62.       maxent           =  128;      { maximum dir entries this program will take }
  63.       Hell_Freezes_Over= False;     { Main driver loop termination... }
  64.       esc              =  ^[;
  65.       BS               =  ^H;
  66.       HI               =  ^['p';
  67.       LO               =  ^['q';
  68.       CURSOR_OFF       =  ^['x5';
  69.       CURSOR_ON        =  ^['y5';
  70.       FK1              =  #$F1;     { function key values }
  71.       FK2              =  #$F2;
  72.       FK3              =  #$F3;
  73.       FK4              =  #$F4;
  74.       FK5              =  #$F5;
  75.       FK6              =  #$F6;
  76.       FK7              =  #$F7;
  77.  
  78. type TimeType     = integer;
  79.      FileNameType = array[1..11] of char;
  80.      LibFileType  = file;
  81.  
  82.      EntryType    = record
  83.                    status         : byte;
  84.                    name           : array[1..8] of char;
  85.                    ext            : array[1..3] of char;
  86.                    index          : integer;
  87.                    length_of_member         : integer;
  88.                    CRC            : integer;
  89.                    CreationDate   : integer;
  90.                    LastChangeDate : integer;
  91.                    CreationTime   : TimeType;
  92.                    LastChangeTime : TimeType;
  93.                    PadCount       : byte;
  94.                    filler         : array[27..31] of byte;
  95.      end;
  96.      EntryPtr     = ^EntryType;
  97.  
  98.      hexstr       = string[4];
  99.      string10     = string[10];
  100.      filename     = string[12];
  101.      maxstr       = string[255];
  102.  
  103. var buffer           : array[0..BufferSize] of byte;
  104.     library,
  105.     file2            : file;
  106.     SizeFile         : file of byte;
  107.     DirectoryChanged : boolean;
  108.     LibName,
  109.     fname            : filename;
  110.     LibSize,
  111.     NumEntries       : integer;
  112.     LibEntry         : EntryType;
  113.     Dir              : array[0..maxent] of EntryPtr;
  114.     active,
  115.     unused,
  116.     deleted          : integer;
  117.     w_table : record x1,x2,y1,y2,
  118.                    currx,curry : integer;
  119.                    overwrote   : array[0..2048] of integer;
  120.             end;
  121.     screen : array[0..2048] of integer absolute $F000:0000;
  122.  
  123. {$I lu-1.pas }   {      Window handlers and status line drivers }
  124.  
  125.   function Confirm: boolean;
  126.     var c: char;
  127.   begin
  128.       w_write_s(' Confirm operation (Y/N): ');
  129.       repeat
  130.           read(kbd,c);
  131.           c := upcase(c);
  132.       until (c in ['Y','N']);
  133.       w_write_c(c);
  134.       confirm := (c = 'Y')
  135.   end;
  136.  
  137.   function hex(num: integer): hexstr;
  138.   var i, j: integer;
  139.       h: string[16];
  140.       str: hexstr;
  141.   begin
  142.       str := '0000';   h := '0123456789ABCDEF';   j := num;
  143.       for i:=4 downto 1 do begin
  144.           str[i] := h[(j and 15)+1];
  145.           j := j shr 4;
  146.       end;
  147.       hex := str;
  148.   end;
  149.  
  150.   procedure MakeName(f: filename; var name: FileNameType);
  151.   var dotpos,
  152.       endname,
  153.       i       : integer;
  154.   begin
  155.       name := '           ';
  156.       for i:=1 to length(f) do
  157.           f[i] := upcase(f[i]);
  158.       dotpos := pos('.',f);
  159.       if dotpos > 0 then begin
  160.           endname := dotpos-1;
  161.           for i:=1 to 3 do
  162.               if (f[ dotpos+i ] <> ' ')
  163.               AND (DOTPOS + I <= LENGTH(F))then (* ONLY copy chars if they   *)
  164.                                                 (* are actually there! - jmp *)
  165.                      name[8+i] := f[dotpos+i];
  166.       end
  167.       else
  168.           endname := length(f);
  169.       for i:=1 to endname do
  170.           name[i] := f[i];
  171.   end;
  172.  
  173.   procedure PutName(f: filename; n: integer);
  174.   var i: integer;
  175.       name: FileNameType;
  176.   begin
  177.       MakeName(f,name);
  178.       for i:=1 to 8 do
  179.           Dir[n]^.name[i] := name[i];
  180.       for i:=1 to 3 do
  181.           Dir[n]^.ext[i]  := name[i+8];
  182.   end;
  183.  
  184.   function FindMember(f: filename): integer;
  185.   var member, dotpos, endname, i, k: integer;
  186.       lookup: FileNameType;
  187.       found: boolean;
  188.  
  189.     function NamesMatch(entry: integer): boolean;
  190.     var match: boolean;
  191.     begin
  192.         NamesMatch := true;
  193.         with Dir[entry]^ do begin
  194.             for k:=1 to 8 do
  195.                 if name[k]<>lookup[k] then
  196.                     NamesMatch := false;
  197.             for k:=1 to 3 do
  198.                 if ext[k]<>lookup[8+k] then
  199.                     NamesMatch := false;
  200.         end;
  201.     end;
  202.  
  203.   begin
  204.       MakeName(f,lookup);
  205.       found := false;   i := 1;
  206.       while not(found) and (i<NumEntries) do
  207.           if NamesMatch(i) then
  208.               found := true
  209.           else
  210.               i := i + 1;
  211.  
  212.       if (active=1) or not(found) then
  213.           FindMember := 0
  214.       else
  215.           FindMember := i
  216.   end;
  217.  
  218.   function Parse(f: filename): filename;
  219.   var i: integer;
  220.   begin
  221.       if f <> '' then begin
  222.           for i:=1 to length(f) do
  223.               f[i]:=upcase(f[i]);
  224.           i := pos('.',f);
  225.           if i>0 then
  226.               f:=copy(f,1,i-1);
  227.           f := f + '.LBR';
  228.       end;
  229.       Parse := f;
  230.   end;
  231.  
  232.   procedure WriteDirectoryToDisk(var lib: LibFileType);
  233.   var member, i: integer;
  234.   begin
  235.       reset(lib);
  236.       member := 0;
  237.       while member < NumEntries do begin
  238.           for i:=0 to EntriesPerBuffer-1 do
  239.               move(Dir[member+i]^,buffer[32*i],32);
  240.           blockwrite(lib,buffer,1);
  241.           member := member + 4
  242.       end;
  243.       DirectoryChanged := false
  244.   end;
  245.  
  246.   procedure ZeroEntry(n: integer);
  247.   begin
  248.       fillchar(Dir[n]^,32,chr(0));      {clear the record}
  249.       fillchar(Dir[n]^.name[1],11,' '); {clear file name}
  250.       Dir[n]^.status := -1;             {mark unused}
  251.   end;
  252.  
  253.   procedure SortDir;
  254.   var i, j: integer;
  255.  
  256.     function larger(a, b: integer): boolean;
  257.     var ok, x: integer;
  258.         c1, c2: char;
  259.     begin
  260.         ok := 0;   x := 1;
  261.         if (Dir[a]^.status <> 0) and (Dir[b]^.status <> 0) then ok := 2;
  262.         if (Dir[a]^.status <> 0) and (ok = 0)              then ok := 1;
  263.         if (Dir[b]^.status <> 0) and (ok = 0)              then ok := 2;
  264.         while (x < 12) and (ok=0) do begin
  265.             c1 := Dir[a]^.name[x];
  266.             c2 := Dir[b]^.name[x];
  267.             if c1 > c2 then ok := 1;
  268.             if c1 < c2 then ok := 2;
  269.             x := x + 1
  270.         end;
  271.         if ok=1 then
  272.             larger := true
  273.         else
  274.             larger := false
  275.     end;
  276.  
  277.     procedure swap(x, y: integer);
  278.     var temp: EntryPtr;
  279.     begin
  280.         temp   := Dir[x];
  281.         Dir[x] := Dir[y];
  282.         Dir[y] := temp
  283.     end;
  284.  
  285.   begin
  286.       for i:=1 to NumEntries-1 do
  287.           if Dir[i]^.status <> 0 then
  288.               ZeroEntry(i);
  289.       for i:=1 to NumEntries-2 do begin
  290.           for j:=i+1 to NumEntries-1 do
  291.               if larger(i,j) then
  292.                   swap(i,j);
  293.       end;
  294.   end;
  295.  
  296.   procedure CreateDirectory;
  297.   var i: integer;
  298.   begin
  299.       w_make(15,65,10,14);
  300.       rewrite(library);
  301.       w_write_s(' Creating a new library.  Name = ');
  302.       w_write_s(LibName); w_writeln;
  303.       w_write_s(' How many entries? ');  readln(i); w_writeln;
  304.       NumEntries := i + 1;        {add 1 for Directory entry}
  305.       i := NumEntries MOD 4;
  306.       if i <> 0 then
  307.           NumEntries := NumEntries + (4 - i);
  308.  
  309.       for i:=0 to NumEntries-1 do begin
  310.           new(Dir[i]);
  311.           ZeroEntry(i);
  312.       end;
  313.  
  314.       Dir[0]^.status := 0; {directory entry is always used}
  315.       Dir[0]^.length_of_member := NumEntries DIV 4;
  316.       active         := 1;
  317.       unused         := NumEntries - 1;
  318.       deleted        := 0;
  319.       WriteDirectoryToDisk(library);
  320.       w_write_s(' Library created and initialized.');
  321.       delay(1000);
  322.       LibSize := (1 + filesize(library)) DIV 8;  {in kilobytes}
  323.       w_delete;
  324.   end;
  325.  
  326.   procedure GetDirectory;
  327.   var i, offset: integer;
  328.   begin
  329.       offset := 0;
  330.       DirectoryChanged := false;
  331.       LibSize := (1 + filesize(library)) DIV 8;  {in kilobytes}
  332.       blockread(library,buffer,1);
  333.       new(Dir[0]);                 {make space for directory header}
  334.       move(buffer[0],Dir[0]^,32);  {move header entry}
  335.       NumEntries := (128 * Dir[0]^.length_of_member) DIV 32;
  336.       for i:=1 to NumEntries-1 do begin
  337.           if (i MOD EntriesPerBuffer) = 0 then begin {read next block}
  338.               blockread(library,buffer,1);
  339.               offset := offset + EntriesPerBuffer;
  340.           end;
  341.           new(Dir[i]);
  342.           move(buffer[32*(i-offset)],Dir[i]^,32);
  343.       end;
  344.       active  := 1;
  345.       unused  := 0;
  346.       deleted := 0;
  347.       for i:=1 to NumEntries-1 do
  348.           if Dir[i]^.status=0 then
  349.               active := active + 1
  350.           else
  351.               if Dir[i]^.status=$FE then
  352.                   deleted := deleted + 1
  353.               else
  354.                   unused := unused + 1;
  355.   end;
  356.  
  357.   procedure OpenLibrary;
  358.   begin
  359.       assign(library,LibName);
  360.       {$I-} reset(library) {$I+};
  361.       if IOresult=0 then
  362.           GetDirectory
  363.       else
  364.           CreateDirectory;
  365.   end;
  366.  
  367.   procedure Directory;
  368.   var i, j: integer;
  369.   begin
  370.       gotoxy(3,6);  write(#$BA,'  name          index  length    CRC');
  371.       gotoxy(41,6); write(#$B3,'  name          index  length    CRC ',#$BA);
  372.       gotoxy(3,7);  write(#$C7); for i := 5 to 79 do write(#$C4); write(#$B6);
  373.       gotoxy(41,7); write(#$C5);
  374.       gotoxy(41,5); write(#$D1);
  375.       for i:=1 to NumEntries-1 do
  376.           with Dir[i]^ do begin
  377.               if odd(i) then begin gotoxy(3,8+(i-1) div 2); write(#$BA); end
  378.               else begin gotoxy(41,8+ (i-1) div 2); write(#$B3); end;
  379.               if status <> $FF then begin
  380.                   if status=$FE then
  381.                       write('*')
  382.                   else write(' ');
  383.                   for j:=1 to 8 do
  384.                       write(name[j]);
  385.                   write('.');
  386.                   for j:=1 to 3 do
  387.                       write(ext[j]);
  388.                   write(' ',index:8,length_of_member:8,'   ',hex(CRC));
  389.               end
  390.               else write('  <empty>                            ');
  391.               gotoxy(79,8+(i-1) div 2);
  392.               write(#$BA);
  393.           end;  (* with *)
  394.       gotoxy(41,8+(i-1) div 2);
  395.       write(#$B3);
  396.       gotoxy(79,8+(i-1) div 2);
  397.       write(#$BA);
  398.       gotoxy(3,9+(i-1) div 2);  write(#$C8);
  399.       for i := 5 to 41 do write(#$CD);
  400.       write(#$CF);
  401.       for i := 43 to 79 do write(#$CD);
  402.       write(#$BC);
  403.   end;
  404.  
  405. {$I lu-2.pas } { command handlers - removed to include file for space reasons }
  406.  
  407.   procedure NewLib;
  408.   var str : filename;
  409.       x : integer;
  410.   begin
  411.       clrscr;
  412.       gotoxy(3,1);
  413.       write(#$C9); for x := 4 to 25 do write(#$CD); write(#$BB);
  414.       gotoxy(3,2); write(#$BA,' Library Utility (LU) ',   #$BA);
  415.       gotoxy(3,3); write(#$BA);gotoxy(26,3);        write(#$BA);
  416.       gotoxy(3,4); write(#$BA,'   version ',V,'       ',  #$BA);
  417.       gotoxy(3,5); write(#$C8);
  418.       for x := 4 to 25 do write(#$CD); write(#$BC);
  419.       w_make(10,70,6,15);
  420.       w_gotoxy(2,2);
  421.       w_write_s('What library file do you want to use?              ');
  422.       w_writeln;
  423.       w_writeln;
  424.       w_write_s('  Library name format is <filename>[.lbr]'); w_writeln;
  425.       w_writeln;
  426.       w_write_s('  The extention ".LBR" is assumed in all cases'); w_writeln;
  427.       w_write_s('  A null filename (just press <CR>) exits the program.');
  428.       w_gotoxy(40,2);
  429.       readln(str); w_writeln;
  430.       LibName := Parse(str);
  431.       if length(LibName)=0 then begin
  432.           gotoxy(1,23);
  433.           halt;
  434.       end;
  435.       w_delete;
  436.   end;
  437.  
  438.   procedure Menu;
  439.   var selection: char;
  440.       x : integer;
  441.   begin
  442.       OpenLibrary;
  443.  
  444.       {    draw character graphics on screen  --  set up display 'form' }
  445.  
  446.       gotoxy(26,1); write(#$CB); for x :=27 to 78 do write(#$CD); write(#$BB);
  447.       gotoxy(27,2);
  448.       write('  Name: ',LibName,'':14-length(LibName),#$B3);
  449.       gotoxy(79,2); write(#$BA);
  450.       gotoxy(26,3);write(#$C7);gotoxy(79,3);write(#$B6);
  451.       gotoxy(27,3); for x := 27 to 78 do write(#$C4);
  452.       gotoxy(79,4); write(#$BA); gotoxy(3,5); write(#$CC);
  453.       for x := 4 to 25 do write(#$CD); write(#$CA);
  454.       for x :=27 to 78 do write(#$CD); write(#$B9);
  455.       gotoxy(49,1); write(#$D1); gotoxy(63,1); write(#$D1);
  456.       gotoxy(49,3); write(#$C5); gotoxy(63,3); write(#$C5);
  457.       gotoxy(49,5); write(#$CF); gotoxy(63,5); write(#$CF);
  458.  
  459.       repeat
  460.           write(CURSOR_OFF);
  461.           if w_table.x1 <> -1 then begin
  462.               delay(2000);
  463.               w_delete;
  464.           end;
  465.           LibSize := (1 + filesize(library)) DIV 8;  {in kilobytes}
  466.  
  467.           { Update info on screen which could have changed cuz of last cmd }
  468.  
  469.           gotoxy(27,4);
  470.           write(     '  Size: ',LibSize:3,'K bytes    ',#$B3);
  471.           gotoxy(50,2);
  472.           write(' Total: ',active+deleted+unused - 1:3,'  ',#$B3);
  473.           gotoxy(50,4);
  474.           write(     ' Active: ',active - 1:3,' ',#$B3);
  475.           gotoxy(64,2);
  476.           write(' Erased: ',deleted:3,'  ');
  477.           gotoxy(64,4);
  478.           write(     ' Unused: ',unused:3);
  479.  
  480.           { turn on status line for function key input }
  481.  
  482.           set_status('1 Extract ','2 Add     ','3 Erase   ',
  483.                      '4 Unerase ','5 Pack    ','6 Help    ','7 Quit    ');
  484.           Directory; { show updated library directory }
  485.           repeat
  486.               read(kbd,selection);
  487.               selection := upcase(selection);
  488.           until (selection in ['X','A','E','U','P','?','H','Q',
  489.                                FK1,FK2,FK3,FK4,FK5,FK6,FK7]);
  490.           clear_status;
  491.           write(CURSOR_ON);
  492.           case selection of
  493.                 'A',FK2: Add;
  494.                 'X',FK1: Extract;
  495.             'H','?',FK6: Help;
  496.                 'E',FK3: Delete; (* erase *)
  497.                 'P',FK5: Reorganize; (* pack *)
  498.                 'U',FK4: Undelete;
  499.                 'Q',FK7:;
  500.           end;
  501.       until selection in ['Q',FK7];
  502.       if DirectoryChanged then WriteDirectoryToDisk(library);
  503.       close(library);
  504.   end;
  505.  
  506. begin {Main}
  507.   w_table.x1 := -1;
  508.   repeat
  509.       NewLib;
  510.       Menu;
  511.   until Hell_Freezes_Over;
  512. end.
  513.